perm filename BRAKE.1[MAC,LSP] blob
sn#210795 filedate 1976-04-10 generic text, type T, neo UTF8
(DECLARE (*FEXPR IOG BRAKE UNBRAKE)
(SPECIAL %#A %#CE W))
(DEFUN BRAKE FEXPR (FORM)
(PROG (FUNAME NUMBER PATTERN CONDITION POSITION BREAK)
(SETQ FORM (CONS NIL FORM))
(COND ((NULL (SETQ FUNAME (GET FORM 'IN)))
(SETQ FUNAME (%GETNAME %#A)))
(T (APPLY '%DATA-INIT (LIST FUNAME))))
(SETQ NUMBER (OR (GET FORM 'NUMBER) 1.)
CONDITION (OR (GET FORM 'IF) T)
POSITION (CAR (OR (MEMBER 'AFTER FORM)
(MEMBER 'BEFORE FORM)))
PATTERN (OR (GET FORM POSITION)
(RETURN 'WHERE??)))
(%EVALUATE 'TOP)
(SETQ BREAK (LIST 'BREAK
(LIST 'IN
FUNAME
POSITION
PATTERN
'NUMBER
NUMBER)
CONDITION))
(RETURN (COND ((NULL (%EVALUATE (LIST 'F
PATTERN
NUMBER)))
'WHERE??)
(T (%EVALUATE (LIST 'CR
(COND ((EQUAL POSITION
'AFTER)
(LIST 'PROG2
NIL
%#CE
BREAK))
((LIST 'PROG2
BREAK
%#CE)))))
(IOG W
(SETQ ↑W T)
(%EVALUATE 'OK))
(%EVALUATE 'TOP)
(LIST FUNAME 'BROKEN))))))
(DEFUN UNBRAKE FEXPR (FORM)
(PROG (?FORM)
(COND (FORM (APPLY '%DATA-INIT FORM)))
(%EVALUATE 'TOP)
(RETURN (DO NIL
((NULL (%EVALUATE '(F (BREAK (IN ?
?
?
NUMBER
?)
?))))
(%EVALUATE 'TOP)
(IOG W (SETQ ↑W T) (%EVALUATE 'OK))
(LIST (%GETNAME %#A) 'UNBROKEN))
(%EVALUATE '↑)
(AND (OR (%MATCH '(PROG2 (BREAK ? ?) ?FORM)
%#CE)
(%MATCH '(PROG2 NIL
?FORM
(BREAK ? ?))
%#CE))
(%EVALUATE '(PR ?FORM)))))))